Pass4L.mesa 2-Sep-78 12:59:59 Page 1 



-- file Pass4L.Mesa 

-- last modified by Satterthwaite, July 17, 1978 4:22 PM 

DIRECTORY 

AltoDefs: FROM "altodefs", 
ComData: FROM "comdata", 
Compi lerDefs : FROM "compilerdef s" , 
ControlDefs: FROM "controldef s" , 
ErrorDefs: FROM "errordefs", 
P4Defs: FROM "p4defs", 
SymDefs: FROM "symdefs", 
SymTabDefs: FROM "symtabdef s" , 
SystemDefs: FROM "systemdef s" , 
TableDefs: FROM "tabledefs". 
TreeDefs: FROM "treedefs"; 

Pass4L: PROGRAM 
IMPORTS 

CompilerDefs, ErrorDefs, SymTabDefs, SystemDefs, TreeDefs, 
dataPtr: ComData 
EXPORTS P4Defs « 
BEGIN 
OPEN SymTabDefs, SymDefs; 

tb: TableDefs. TableBase; -- tree base (local copy) 

seb: TableDefs. TableBase; -- se table base (local copy) 

ctxb: TableDefs. TableBase; -- context table base (local copy) 

bb: TableDefs. TableBase; -- body table base (local copy) 

LayoutNotify: PUBLIC TableDefs .TableNotifier = 

BEGIN -- called by allocator whenever table area is repacked 

tb <- base[TreeDefs. treetype]; 

seb "<- base[setype] ; ctxb <- base[ctxtype] ; 

bb *- base[bodytype]; RETURN 

END; 



-- address assignment (machine sensitive and subject to change) 

WordLength: CARDINAL = Al toDef s.wordlength; 
WordFill: CARDINAL = WordLength-1; 
ByteLength: CARDINAL = Al toDef s .charlength; 
BytesPerWord: CARDINAL = WordLength/ByteLength; 

LocalOrigin: CARDINAL = ControlDefs . localbase*WordLength; 
GlobalOrigin: CARDINAL = ControlDefs .globalbase*WordLength; 
FrameLimit: CARDINAL = ControlDefs .MaxFrameSize*WordLength; 

EntryLimit: CARDINAL = ControlDefs .MaxNGfi * ControlDefs .EPRange; 

BitsForType: PUBLIC PROCEDURE [type: SEIndex] RETURNS [nBits: CARDINAL] = 
BEGIN -- assumes (an attempt at) prior processing by P4declitem 
b, nW: CARDINAL; 

sei: CSEIndex *- UnderType[type]; 
WITH (seb+sei) SELECT FROM 
basic => nBits ^ length; 
pointer => nBits <- WordLength; 

transfer => nBits <- IF mode = port THEN 2*WordLength ELSE WordLength; 
arraydesc => nBits ^ 2*WordLength; 
relative => nBits ^ BitsForType[off setType]; 
long => 
BEGIN 

nW <- (BitsForType[rangetype] + WordFil 1 )/WordLength; 
nBits <- (nW + l)*WordLength ; 
END; 
real «> nBits <- 2*WordLength; 

ENDCASE «> -- processing of se entry must be complete 
BEGIN 
IF '-mark4 
THEN 

BEGIN -- P4declitem has not been able to complete 
ErrorDefs .errorsei[typeLength, 
IF (seb+type) . setag « id 

THEN LOOPHOLE[type. ISEIndex] 
ELSE ISENull]; 
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RETURN [0] 
END; 
WITH (seb+sei) SELECT FROM 

enumerated ■> nBits ^ BitsForRange[Cardina1 ity[sei]-l] ; 
record »> BEGIN nBits <- length; lengthUsed <- TRUE END; 
array => 
BEGIN 

b <- BitsForType[cofnponenttype] ; 
nW <- IF packed AND b <» ByteLength 

THEN (Cardina1ity[indextype] + (BytesPerWord-l))/BytesPerWord 
ELSE Cardinality[indextype] * ((b + WordFill )/WordLength) ; 
IF nW > AHoDef s .maxword/WordLength 

THEN ErrorDef s .error[fieldSize]; 
nBits <- nW*WordLength; lengthUsed <- TRUE; 
END; 
subrange »> 

nBits +- IF empty THEN ELSE BitsForRange[Cardinal ity[sei]-l] ; 
ENDCASE »> nBits <- 0; 
END; 
RETURN 
END; 

ArgLength: PUBLIC PROCEDURE [type: SEIndex] RETURNS [length: CARDINAL] » 
BEGIN 

sei: CSEIndex « UnderType[type] ; 
length ♦- 0; 

WITH (seb+sei) SELECT FROM 
transfer => 
BEGIN 

IF inrecord ff SENull THEN 
BEGIN 

length *- length + (seb+inrecord) . length; 
(seb+inrecord) . lengthUsed <- TRUE; 
END; 
IF outrecord ff SENull THEN 
BEGIN 

length «- length + (seb+outrecord) . length; 
(seb+outrecord) .lengthUsed <- TRUE; 
END; 
END; 
definition => NULL; 
ENDCASE »> ERROR; 
RETURN 
END; 

-- profile utilities 

Varlnfo: TYPE = RECORD [ 
link: ISEIndex, 
nRefs: CARDINAL]; 

Profile: TYPE = DESCRIPTOR FOR ARRAY OF Varlnfo; 

AllocateProfile: PROCEDURE [n: INTEGER] RETURNS [profile: Profile] = 
BEGIN 

k: INTEGER; 

profile ^ DESCRIPTOR [SystemDef s . Al locateHeapNode[n*SIZE[VarInf o]] . n]; 
FOR k IN [0 .. n) DO prof ile[k] . 1 ink <- ISENull ENDLOOP; 
RETURN 
END; 

ReleaseProf ile: PROCEDURE [profile: Profile] = 
BEGIN 

SystemDef s . FreeHeapNode[ BASE [prof ile]]; 
RETURN 
END; 

SortProfile: PROCEDURE [v: Profile] « 
BEGIN -- Shell sort — 
h, i, j: INTEGER; 
k: CARDINAL; 
t: Varlnfo; 
h ♦- LENGTH [v]; 

DO 

h <- h/2; 
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FOR j IN [h .. LENGTH[v]) 
DO 

i *- j-h; k ^ v[j].nRefs; t <- v[j]; 
WHILE k > v[i].nRefs 
DO 

v[i + h] ♦- v[i] ; 
IF (i <- i-h) < THEN EXIT; 
ENDLOOP; 
v[i+h3 ♦- t; 
ENDLOOP; 
IF h <=1 THEN EXIT; 
ENDLOOP; 
RETURN 
END; 



-- entry point assignment 

GenBodies: PROCEDURE [root: BTIndex, proc: PROCEDURE [CBTIndex]] =» 
BEGIN 

bti, next: BTIndex; 

FOR bti *■ root, next UNTIL bti « BTNull 
DO 
WITH (bb+bti) SELECT FROM 

Callable => proc[LOOPHOLE[bti]]; 
ENDCASE => NULL; 
IF (bb+bti). firstSon # BTNull 
THEN next ^ (bb+bti ) .firstSon 
ELSE 
DO 

next *■ (bb+bti ). 1 ink. index; 

IF next = BTNull OR (bb+bti ). 1 ink. which # parent THEN EXIT; 
bti ^ next; 
ENDLOOP; 
ENDLOOP; 
RETURN 
END; 



BodyRefs: PROCEDURE [bti: CBTIndex] RETURNS [count: CARDINAL] 
BEGIN 

sei: ISEIndex; 
node: TreeDefs .Treelndex; 

CountRefs: TreeDefs .TreeScan « 
BEGIN 
WITH t SELECT FROM 

symbol => count <- count + (seb+index) . idinfo; 

ENDCASE => ERROR; 
RETURN 
END; 

count *- 0; 
sei ^ (bb+bti). id; 

IF sei # SENull AND (bb+bti ). nesting = Outer 
THEN 

BEGIN node +• (seb+sei) . idvalue; 

TreeDefs. scanl ist[(tb+node) . sonl , CountRefs]; 

END; 
RETURN 
END; 



AssignEntries: PUBLIC PROCEDURE [rootBti: BTIndex] 
BEGIN 

i, j, k: INTEGER; 
profile: Profile; 
bti: CBTIndex; 

AssignSlot: PROCEDURE [bti: CBTIndex] - 
BEGIN 

IF (bb+bti) . info. mark » Internal 
THEN 
BEGIN 
profile[k] <- VarInfo[ 

link: LOOPHOLE[bti]. 
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nRefs: IF (bb+bti) .nesting ° Inner 
THEN 

ELSE BodyRefs[LOOPHOLE[bti]]]; 
k +- k+1; 
END; 
RETURN 
END; 

IF MAX[dataPtr.nBodies, dataPtr. nSigCodes] > EntryLimit 

THEN ErrorDefs.error[ body En tries]; 
profile ^ AllocateProf i1e[dataPtr.nBodies]; 
k ^ 0; GenBodies[rootBti , AssignSlot]; 
IF dataPtr.sort THEN SortProFiie[prof ile] ; 
i ^ 1; 
FOR j IN [O..LENGTH[profile]) 

DO 

bti <r L00PH0LE[profile[j].1ink]; 

IF bti = dataPtr .mainBody 
THEN (bb+bti), entrylndex *- 
ELSE BEGIN (bb+bti ). entrylndex ^ i; i ♦- i + 1 END; 

ENDLOOP; 
ReleaseProf ile[profile]; RETURN 
END; 



-- frame layout 

VarScan: TYPE = PROCEDURE [sei: ISEIndex. output: BOOLEAN]; 

GenCtxVars: PROCEDURE [ctx: CTXIndex. p: VarScan, output: BOOLEAN] 
BEGIN 

sei: ISEIndex; 
IF ctx ^ CTXNull THEN 

FOR sei <- (ctxb+ctx).selist, NextSe[sei] UNTIL sei = SENull 

DO 

IF '-(seb+sei) .constant THEN p[sei, output]; 

ENDLOOP; 
RETURN 
END; 

GenBodyVars: PROCEDURE [bti: CBTIndex, p: VarScan] « 
BEGIN 

type: SEIndex = (bb+bti) . ioType; 
WITH se: (seb+type) SELECT FROM 
constructor «> 

WITH se SELECT FROM 
transfer => 
BEGIN 
IF inrecord ^ SENull 

THEN GenCtxVars[(seb+inrecord).fieldctx, p, FALSE]; 
IF outrecord ^ SENull 

THEN GenCtxVars[(seb+outrecord). fieldctx. p, TRUE]; 
END; 
ENDCASE; 
ENDCASE; 
GenCtxVars[(bb+bti) .localCtx, p, FALSE]; 
RETURN 
END; 

GenlmportedVars: PROCEDURE [p: VarScan] » 
BEGIN 

sei: ISEIndex; 
type: CSEIndex; 

ctx: CTXIndex = dataPtr . importCtx; 
IF ctx # CTXNull THEN 

FOR sei <- (ctxb+ctx).selist, NextSe[sei] UNTIL sei « SENull 
DO 

IF ~(seb+sei ) .constant 
THEN p[sei. FALSE] 
ELSE 

BEGIN type <- UnderType[( seb+sei) . idtype]; 
WITH (seb+type) SELECT FROM 

definition => GenCtxVars[defCtx , p, FALSE]; 
ENDCASE; 
END; 
ENDLOOP; 
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RETURN 
END; 

BumpArgRefs: PROCEDURE [rsei: recordCSEIndex] ■ 
BEGIN 

sei: ISEIndex; 
- node: TreeDef s .Treelndex; 

savelndex: CARDINAL ■ dataPtr. textlndex; 
IF rsei # SENull 
THEN 

FOR sei ^ (ctxb+(seb+rsei) .fieldctx) .selist, NextSe[sei] UNTIL sei » SENull 
DO 

IF (seb+sei).idinfo » AND (seb+sei ) .htptr # HTNull 
THEN 

BEGIN node ^ LOOPHOLE[(seb+sei) . idvalue]; 
dataPtr. textlndex <- (tb+node) . info; 
ErrorDef s .WarningSei[unusedId, sei]; 
END; 
(seb+sei) . idinfo ^ (seb+sei ). idinfo + 1; 
ENDLOOP; 
dataPtr. textlndex <- savelndex; RETURN 
END; 

CheckArguments: PROCEDURE [bti: CBTIndex] = 
BEGIN 

bodyType: SEIndex « (bb+bti ) . ioType; 
node: TreeDef s. Treelndex; 
WITH type: (seb+bodyType) SELECT FROM 
constructor => 

WITH type SELECT FROM 
transfer »> 
BEGIN 

WITH (bb+bti). info SELECT FROM 
Internal => node *- bodyTree; 
ENDCASE => ERROR; 
BumpArgRef s[inrecord]; 

IF (tb+node) .attr2 THEN BumpArgRef s[outrecord] ; ** field? 
END; 
ENDCASE => ERROR; 
ENDCASE; 
RETURN 
END; 

LayoutLocals: PUBLIC PROCEDURE [bti: CBTIndex] RETURNS [length: CARDINAL] « 
BEGIN 

vProf ile: Profile; 
vl: CARDINAL; 

CountVar: VarScan « 
BEGIN 

IF (seb+sei), htptr # HTNull OR -output THEN vl *- vl + 1; 
RETURN 
END; 

InsertVar: VarScan =» 
BEGIN 

savelndex: CARDINAL = dataPtr . textlndex; 
node: TreeDef s .Treelndex = LOOPHOLE[(seb+sei) . idvalue] ; 
nW: CARDINAL; 
IF node ft TreeDef s . nullTreelndex 

THEN dataPtr. textlndex <- (tb+node) . info; 
IF (seb+sei). htptr # HTNull OR -output 
THEN 
BEGIN 

vProfile[vI] ^ [link:sei, nRefs : (seb+sei) . idinfo]; vl ^ vI+1; 
END; 
IF (seb+sei). idinfo = AND (seb+sei ). htptr # HTNull 
AND -output -- suppress message for return record 
THEN ErrorDef s .WarningSei[unusedId, sei]; 
nW «- (BitsForType[(seb+sei) . idtype] + WordFil 1 )/WordLength; 
(seb+sei ). idinfo <- nW*WordLength; (seb+sei ). idvalue <- 0; 
dataPtr . textlndex <- savelndex; RETURN 
END; 
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origin: CARDINAL; 
CheckArgunients[bti]; 
vl <- 0; GenBodyVars[bti , CountVar]; 
vProfile ♦- AllocateProf i1e[vl]; 
vl <- 0; GenBoclyVars[bti , InsertVar]; 
SortProfile[vProf ile]; 
origin *- IF (bb+bti) . level ■ 1L 
THEN LocalOrigin 
ELSE LocalOrigin + WordLength; 
IF (seb+{bb+bti) . ioType) .setag » id 
THEN -- must be a procedure type 
BEGIN 

IF origin ■ LocalOrigin 
THEN 

BEGIN -~ fill link word 

[] <- AssignVars[vProf ile, LocalOrigin, LocalOrigin+WordLength]; 
origin ^ origin+WordLength; 
END; 
origin ^ origin + ArgLength[(bb+bti) . ioType]; 
END; 
origin ^ Assign\/ars[vProf ile, origin, LocalOrigin + ControlDef s . localslots*WordLength]; 
length ^ Assign\/ars[vProf ile, origin, FrameLimit]; 
CheckFranieOverflow[ vProfile] ; ReleaseProfile[vProfile]; 
IF (bb+bti). level > IL 
AND length > ControlDef s .MaxSmal lFrameSize*WordLength 

THEN ErrorDef s .errorsei[addressOverf low, (bb+bti) . id]; 
RETURN 
END; 

LayoutGlobals: PUBLIC PROCEDURE [bti: CBTIndex] RETURNS [length: CARDINAL] « 
BEGIN 

vProfile, xProfile: Profile; 
vl, xl: CARDINAL; 

CountVar: VarScan » 
BEGIN 

ctx: CTXIndex = (seb+sei) .ctxnum; 

IF (ctxb+ctx) .ctxType » imported OR ctx = dataPtr. importCtx 
THEN xl <- xl + 1 
ELSE 

IF (seb+sei). htptr ^ HTNull OR -output THEN vl <- vl + 1; 
RETURN 
END; 

InsertVar: VarScan » 
BEGIN 

savelndex: CARDINAL; 
ctx: CTXIndex « (seb+sei ). ctxnum; 
node: TreeDef s . Treelndex; 
nW: CARDINAL; 

IF (ctxb+ctx) . CtxType = imported OR ctx = dataPtr. importCtx 
THEN 
BEGIN 

xProfile[xI] *- [link:sei, nRefs: (seb+sei) . idinfo]; xl ♦- xI+1; 
IF (seb+sei ). idinfo = AND -(seb+sei ) .publ ic 

THEN ErrorDef s .WarningSei[unusedId, sei]; 
(seb+sei) . idinfo ♦- 

(( Bi ts For Type[( seb+sei) . idtype]+WordFin ) /WordLength) ♦WordLength; 
END 
ELSE 

BEGIN savelndex *- dataPtr . textlndex; 
node *- LOOPHOLE[(seb+sei) . idvalue]; 
IF node # TreeDef s . nul ITreelndex 

THEN dataPtr. textlndex <- ( tb+node) . info; 
IF (seb+sei). htptr # HTNull OR -output 
THEN 
BEGIN 

vProfile[vI] ^ [link:sei, nRefs: (seb+sei) . idinfo]; vl ♦- vl + 1; 
END; 
IF (seb+sei) . idinfo ■ 

AND -(seb+sei) .public AND (seb+sei ). htptr ff HTNull 
THEN ErrorDef s.WarningSei[unusedId, sei]; 
nW <- (BitsForType[(seb+sei ) . idtype] + WordFill )/WordLength; 
(seb+sei ). idinfo *- nW*WordLength; (seb+sei) . idvalue <- 0; 
dataPtr . textlndex <- savelndex; 
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END; 
RETURN 
END; 

origin: CARDINAL; 

IF (seb+(bb+bti).ioType).setag - id THEN ERROR; 

CheckArguments[bti] ; 

vl ^ xl ^ 0; GenBodyVars[bti , CountVar]; GenImportedVars[CountVar]; 

vProfiTe ♦- AllocateProf ile[vli ; xProfile ♦- AllocateProf ile[xl] ; 

vl <- xl <- 0; GenBodyVars[bti , InsertVar]; GenImported\/ars[InsertVar]; 

TF Hri'ffiPtP ^inpt 

THEN BEGIN SortProf i 1 e[vProf i 1 e] ; SortProf i1e[xProf ile] END; 
origin ^ IF dataPtr. stopping THEN GlobalOrigin+WordLength ELSE GlobalOrigin; 
AssignXfers[xProf ile, 0, 256*WordLength]; 
origin <- Assign\/ars[vProf ile, origin, FrameLimit]; 
length <- MAX[origin, GlobalOrigin+WordLength]; 
CheckFrameOverf low[vProf ile]; ReleaseProf i1e[vProf ile] ; 
CheckFrameOverf 1ow[xProf ile] ; ReleaseProf ile[xProf ile]'; 
RETURN 
END; 

LayoutBlock: PUBLIC PROCEDURE [bti: BTIndex, origin: CARDINAL] RETURNS [length: CARDINAL] 
BEGIN 

vProf ile: Profile; 
vl: CARDINAL; 

CountVar: VarScan = 
BEGIN 

vl ♦- vl + 1; RETURN 
END; 

InsertVar: VarScan » 
BEGIN 

savelndex: CARDINAL = dataPtr , textlndex; 
node: TreeDef s .Treelndex = LOOPHOLE[(seb+sei) . idvalue] ; 
nW: CARDINAL; 
IF node # TreeDefs .nullTreelndex 

THEN dataPtr. textlndex <- ( tb+node) . info; 
vProfile[vI] ^ [link:sei, nRef s:(seb+sei) . idinfo] ; vl «- vI+1; 
IF (seb+sei) . idinfo = THEN ErrorDef s .WarningSei[unusedId» sei]; 
nW <- (BitsForType[(seb+sei) . idtype] + WordFil 1 )/WordLength; 
(seb+sei) . idinfo ♦- nW*WordLength; (seb+sei ). idvalue <- 0; 
dataPtr, textlndex ^ savelndex; RETURN 
END; 

vl ♦- 0; GenCtxVars[(bb+bti) .localCtx, CountVar. FALSE]; 
vProfile *- Al locateProf ile[vl] ; 

vl ^ 0; GenCtxVars[(bb+bti). localCtx, InsertVar, FALSE]; 
SortProfile[ vProfile]: 

length «- AssignVars[vProf il e, origin, FrameLimit]; 
CheckFrameOverf low[vProf ile] ; ReleaseProfile[vProfile]; 
IF (bb+bti). level > IL 

AND length > ControlDef s .MaxSmal lFrameSize*WordLength 
THEN ErrorDefs .errorsei[addressOverf low, dataPtr . seAnon]; 
RETURN 
END; 

Layoutlnterface: PUBLIC PROCEDURE [bti: CBTIndex] RETURNS [nEntries: CARDINAL] « 
BEGIN 

sei: ISEIndex; 
epN: CARDINAL; 
nW: CARDINAL; 
node: TreeDef s .Treelndex; 
savelndex: CARDINAL; 
epN <- 0; 

FOR sei <- (ctxb+(bb+bti). localCtx). selist, NextSe[sei] UNTIL sei » SENull 
DO 

IF ~(seb+sei) .constant 
THEN 

BEGIN savelndex <- dataPtr . textlndex; 
node ^ LOOPHOLE[{seb+sei). idvalue]; 
IF node // TreeDef s .nul ITreelndex 

THEN dataPtr. textlndex ^ (tb+node) . info; 
nW ^ ^BitsForType[(seb+sei ). idtype] + WordFil 1 )/WordLength; 
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(seb+sei) . idinfo <- nW*WordLength ; 
SELECT XferMod0[(seb+sei).idtype] FROM 
procedure, signal, error, program ■> 
BEGIN (seb+sei). linkSpace <- TRUE; 
(seb+sei) .idvalue ♦- epN; epN <- epN + 1; 
END; 
ENDCASE «-> (seb+sei). idvalue ♦- 0; 
dataPtr.textlndex ^ savelndex; 
END; 
ENDLOOP; 
IF (nEntries<-epN) > EntryLimit THEN ErrorDef s .error[interf aceEntries]; 
RETURN 
END; 

CheckFrameOverflow: PROCEDURE [profile: Profile] ■ 
BEGIN 

i: INTEGER; 
FOR i IN [0 .. LENGTH[profile]) 

DO 

IF profile[i].link # SENull 

THEN ErrorDefs.errorsei[addressOverf low, prof ile[i].l ink]; 

ENDLOOP; 
RETURN 
END; 

Align: PROCEDURE [offset: CARDINAL, type: SEIndex] RETURNS [CARDINAL] » 
BEGIN 

RETURN [SELECT Xf erMode[type] FROM 
port «> 

(offset+WordLengtli)/(4*WordLength)*(4*WordLength) + (2*WordLength) , 
ENDCASE => offset] 
END; 

AssignVars: PROCEDURE [profile: Profile, origin, limit: CARDINAL] RETURNS [CARDINAL] 
BEGIN 

start, base, remainder, delta: CARDINAL; 
i, j, next: INTEGER; 
sei, t: ISEIndex; 
found, skips: BOOLEAN; 
size, nRefs: CARDINAL; 

next <- 0; start <- origin; remainder <- limit - origin; 
WHILE next < LENGTH[prof ile] 
DO 

i <- next; found ^ skips ♦- FALSE; 
WHILE -found AND i < LENGTH[prof ile] 
DO 

sei <- prof ile[i]. 1 ink; 
IF sei ff SENull 
THEN 

BEGIN OPEN (seb+sei); 

base ♦- Align[start, idtype]; delta <- base - start; 
IF idinfo + delta <« remainder 
THEN 

BEGIN nRefs ♦- 0; size ^ 0; 
FOR j <- i+1, j+1 WHILE j < LENGTH[prof ile] 
DO 

t ^ prof ile[j] .1 ink; 
IF t # SENull 
THEN 

BEGIN size ^ size + (seb+t) . idinfo; 
IF size > (seb+sei). idinfo THEN EXIT; 
nRefs ♦- nRefs + prof ile[j]. nRefs; 
END; 
ENDLOOP; 
IF nRefs <= prof ile[i]. nRefs OR -dataPtr . sort 
THEN 
BEGIN 

found ^ TRUE; 

idvalue *- BitAddress[wd:base/WordLength, bd:0]; 
mark4 ♦- TRUE; prof ile[i] . 1 ink ♦- ISENull; 
IF base # start AND dataPtr.sort 

THEN [] «~ AssignVars[prof ile, start, base]; 
start ♦- base + idinfo; 
remainder <- remainder - ( idinfo+delta) ; 
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END 
ELSE 

IF -skips THEN BEGIN skips <- TRUE; next ^ i END; 
END; 
END; 
i ♦- i+1; 

IF -skips THEN next *- i ; 
ENDLOOP; 
ENDLOOP; 
RETURN [start] 
END; 

AssignXfers: PROCEDURE [profile: Profile, origin, limit: CARDINAL] - 
BEGIN 

nProcs: CARDINAL; 
next: CARDINAL; 
i, j: CARDINAL; 
sei: ISEIndex; 
t: Varlnfo; 

i <- nProcs <- LENGTH[prof ile]; 
UNTIL i « 
DO 

i ♦- i-1; 

IF XferMode[(seb+prof i1e[i] . 1 ink) . idtype] ^ procedure 
THEN 
BEGIN 

nProcs <- nProcs-1; t <- profi1e[i]; 

FOR j IN [i.. nProcs) DO profi1e[j] ^ profi1e[j+l] ENDLOOP; 
prof ile[nProcs] ♦- t; 
END; 
ENDLOOP; 
-- the xfer frame fragment begins at origin 
dataPtr . 1 inkBase <- origin/WordLength; 

CompilerDefs.AppendBCDWord[dataPtr.linkCount <- LENGTH[prof ile]] ; 
i <- LENGTH[profi1e]; 

next ^ MIN[origin + LENGTH[prof ile]*WordLength, limit]; 
UNTIL i = OR next = origin 
DO 

i <- i-1; sei <- prof ile[i] . 1 ink ; prof i1e[i] . 1 ink <- ISENull ; 
next <- next - (seb+sei) . idinfo; 
CompilerDefs . AppendBCDWord[(seb+sei ) . idvalue] ; 
(seb+sei) . idvalue <- BitAddress[wd: next/WordLength, bd : 0]; 
(seb+sei) .linkSpace <- TRUE; 
ENDLOOP; 
RETURN 
END; 

GenLocalProcs: PROCEDURE [firstBti: BTIndex. proc: PROCEDURE [CBTIndex]] « 
BEGIN 

bti: BTIndex; 

IF (bti *- firstBti) ^ BTNulT 
THEN 
DO 

WITH body: (bb+bti) SELECT FROM 
Callable => proc[LOOPHOLE[bti]]; 
ENDCASE => NULL; 
IF (bb+bti). link. which » parent THEN EXIT; 
bti ^ (bb+bti). 1 ink. index; 
ENDLOOP; 
RETURN 
END; 

AssignLocalDescriptors: PUBLIC PROCEDURE [first: BTIndex, origin: CARDINAL] RETURNS [CARDINAL] 
BEGIN 

i, j, k, n: INTEGER; 
w: CARDINAL; 
profile: Profile; 
bti: CBTIndex; 

GenLocals: PROCEDURE [proc: PROCEDURE [CBTIndex]] - 
BEGIN 

bti: BTIndex; 
IF (bti ^ first) // BTNull 
THEN 
DO 
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WITH (bb+bti) SELECT FROM 

Callable => proc[LOOPHOLE[bti]]; 
ENDCASE »> NULL; 
IF (bb+bti). link. which - parent THEN EXIT; 
bti *• (bb+bti) .link, index; 
ENDLOOP; 
RETURN 
END; 

CountLocal: PROCEDURE [bti: CBTIndex] - 
BEGIN 

IF (bb+bti) .info. mark « Internal THEN n ^ n+1; 
RETURN 
END; 

AssignLocal: PROCEDURE [bti: CBTIndex] ■ 
BEGIN 

IF (bb+bti) . info. mark » Internal 
THEN 

BEGIN 

profile[k] ♦- VarInfo[l ink:LOOPHOLE[bti], nRef s:BodyRef s[bti]]; 

k *- k+1; 

END; 
RETURN 
END; 

n ♦- 0; GenLocals[CountLocal ]; 
profile <- AllocateProf ile[n]; 
k ♦- 0; GenLocals[AssignLocal]; 
SortProf ile[profile]; 
w ^ (origin + WordFil 1 )/WordLength; 
i <- 1; 

FOR j IN [0. .LENGTH[profile]) 
DO 

bti ^ L00PH0LE[profile[j3.1ink]; 
WITH (bb+bti) SELECT FROM 
Inner => 

BEGIN -- align to 4n+2 

frameOffset *- w <- ((w+l)/4)*4 +2; w *- w+1; 
END; 
ENDCASE => ERROR; 
ENDLOOP; 
ReleaseProf ile[prof ile]; 
RETURN [w*WordLength] 
END; 

-- parameter record layout 

LayoutArgs: PUBLIC PROCEDURE [argRecord: recordCSEIndex, origin: CARDINAL, body: BOOLEAN] 
RETURNS [CARDINAL] = 
BEGIN 

w, nW: CARDINAL; 
ctx: CTXIndex; 
sei: ISEIndex; 
w <- origin ; 
IF argRecord ^ SENull 
THEN 

BEGIN ctx ^ (seb+argRecord) .f ieldctx; 

FOR sei *- (ctxb+ctx).selist, NextSe[sei] UNTIL sei « SENull 
DO 

OPEN (seb+sei); 

nW ♦- (BitsForType[idtype] + WordFil 1 )/WordLength; 
IF -body 
THEN 

BEGIN idinfo <- nW*WordLength ; idvalue <- BitAddress[wd:w, bd:0]; 
END; 
w <- w + nW; 
ENDLOOP; 
END; 
RETURN [w] 
END; 

-- record layout 
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ScanVariants: PROCEDURE 

[caseCtx: CTXIndex, proc: PROCEDURE [recordCSEIndex] RETURNS [BOOLEAN]] 
RETURNS [BOOLEAN] - 
BEGIN 

sei: ISEIndex; 
rSei: SEIndex; 

FOR sei ^ (ctxb+caseCtx) .selist, N9xtSe[sei] UNTIL sei ■ SENull 
DO 

rSei <- (seb+sei) . idinfo; 
WITH variant: (seb+rSei) SELECT FROM 
constructor »> 

WITH variant SELECT FROM 

record «> IF proc[LOOPHOLE[rSei]] THEN RETURN [TRUE]; 
ENDCASE -> ERROR; 
ENDCASE H> NULL; -- skip multiple identifiers 
ENDLOOP; 
RETURN [FALSE] 
END; 

LayoutFields: PUBLIC PROCEDURE [rSei: recordCSEIndex, offset: CARDINAL] ■ 
BEGIN 

w, b: CARDINAL; 
lastFillable: BOOLEAN; 
lastSei: ISEIndex; 

AssignField: PROCEDURE [sei: ISEIndex] « 
BEGIN OPEN id: (seb+sei); 
n, nW. nB: CARDINAL; 

savelndex: CARDINAL = dataPtr . textlndex; 

dataPtr. textlndex ^ {tb+LOOPHOLE[id. idvalue, TreeDef s.Treelndex]) . info; 
IF id. idinfo = AND -id. public AND id.htptr # HTNull 

THEN ErrorDef s.WarningSei[unusedId, sei]; 
n ^ BitsForType[id . idtype]; 
nW ^ n/WordLength; nB <- n MOD WordLength; 
IF nW > AND nB j^ 

THEN BEGIN nW ^ nW+1; nB <- END; 
IF (nW > OR b+nB > WordLength) AND b # 

THEN BEGIN w *- w+1; b ♦- END; 
dataPtr. textlndex <- savelndex; 

IF b = AND lastFillable THEN Fil lWord[lastSei] ; 
id. idinfo <- nW*WordLength + nB; 
id. idvalue ^ BitAddress[wd:w, bd:b]; 
lastSei ♦- sei; lastFillable <- (nW » 0); 
w ♦- w + nW; b <- b + nB; 

IF b >= WordLength THEN BEGIN w ^ w+1; b <- b - WordLength END; 
RETURN 
END; 

FillWord: PROCEDURE [sei: ISEIndex] » 
BEGIN 

t: BitAddress * (seb+sei) . idvalue; 
width: CARDINAL = WordLength - t.bd; 
IF (seb+rSei) .machineDep AND width ^ (seb+sei ). idinfo 

THEN ErrorDefs.WarningSei[recordGap, sei]; 
(seb+sei ). idinfo *- width; 
RETURN 
END; 

FindFit: PROCEDURE [vSei: recordCSEIndex] RETURNS [BOOLEAN] - 
BEGIN 

sei: ISEIndex; 
type: CSEIndex; 

sei ^ (ctxb+(seb+vSei) .f ieldctx) .sei ist; 
IF sei = SENull THEN RETURN [FALSE]; 
type <~ UnderType[(seb+sei ). idtype]; 
WITH (seb+type) SELECT FROM 
union «> 

IF controlled 
THEN sei ^ tagsei 

ELSE RETURN [ScanVariants[casectx . FindFit]]; 
ENDCASE => NULL; 
RETURN [BitsForType[(seb+sei) .idtype] + b <- WordLength] 
END; 

vOrigin: CARDINAL; 
maxLength: CARDINAL; 
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AssignVariant: PROCEDURE [vSei: recordCSEIndex] RETURNS [BOOLEAN] ■ 
BEGIN 

LayoutFields[vSei , vOrigin]; 
maxLength <- MAX[(seb+vSei) .length, maxLength]; 
RETURN [FALSE] 
END; 

eqLengths: BOOLEAN; 
padEnd: CARDINAL; 

PadVariant: PROCEDURE [vSei: recordCSEIndex] RETURNS [BOOLEAN] - 
BEGIN 

sei. fillSei: ISEIndex; 
type: CSEIndex; 
fillOrigin: CARDINAL; 
t: BitAddress; 

ctx: CTXIndex « (seb+vSei ) .f iel dctx; 
fillSei ♦- ISENull; 

FOR sei ^ (ctxb+ctx).selist, NextSe[sei] UNTIL sei ■ SENull 
DO 

IF L00PH0LE[(seb+sei).idva1ue, BitAddress]. wd # w THEN EXIT; 
fillSei <- sei; 
ENDLOOP; 
IF fillSei ^ SENull 
THEN 
BEGIN 

t ^ (seb+fillSei). idvalue; fillOrigin <- t.wd*WordLength + t.bd; 
IF fillOrigin + (seb+f il ISei) . idinfo < padEnd 
THEN 
BEGIN 

type ♦- UnderType[(seb+f illSei) .idtype]; 
WITH (seb+type) SELECT FROM 
union => 
BEGIN 

saveLastSei: ISEIndex = lastSei; 

IF controlled THEN lastSei ^ tagsei; -- for messages only 
[] <" Scan\/ariants[casectx, PadVariant]; 
lastSei ^ saveLastSei; 
END; 
ENDCASE => 

IF (seb+rSei) .machineDep 

THEN ErrorDefs .WarningSei[recordGap, fillSei]; 
(seb+fillSei). idinfo ^ padEnd - fillOrigin; 
END; 
END 
ELSE 

IF vOrigin < padEnd AND (vOrigin # OR maxLength < WordLength) 
THEN 
BEGIN 
IF (seb+rSei) .machineDep 

THEN ErrorDefs. WarningSei[recordGap, lastSei]; 
fillSei ^ makectxse[HTNull, CTXNull]; 

(seb+f illSei) .public *- TRUE; (seb+f il ISei) .extended «- FALSE; 
(seb+f illSei) .constant ♦- (seb+f il ISei) .writeonce <- FALSE; 
(seb+f illSei) .linkSpace *- FALSE; 
(seb+fillSei). idtype <- dataPtr . idANY; 
(seb+f illSei) . idvalue <- BitAddress[wd:w» bd:b]; 
(seb+f illSei ). idinfo *- padEnd - vOrigin; 
(seb+f illSei). marks ♦- ( seb+f il ISei) .mark4 <- TRUE; 
WITH (seb+fillSei) SELECT FROM 

linked => link ^ (ctxb+ctx) .sei 1st; 
ENDCASE => ERROR; 
(ctxb+ctx) .sei ist *■ fillSei; 
END; 
(seb+vSei) .length <- MIN[ 
maxLength , 

((seb+vSei) .length + WordFill )/WordLength * WordLength]; 
IF (seb+vSei) .length ^ maxLength THEN eqLengths ♦- FALSE; 
RETURN [FALSE] 
END; 

sei: ISEIndex; 

type: CSEIndex; 

ctx: CTXIndex « (seb+rSei) .f ieldctx; 

w *- offset/WordLength; b ^ offset MOD WordLength; 
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lastFillable ^ FALSE; lastSei ^ ISENull; 
FOR sei ^ (ctxb+ctx).selist. NextSe[sei] UNTIL sei ■ SENull 
DO 

IF -(seb+sei) .constant 
THEN 
BEGIN 

type ^ UnderType[(seb+sei) . idtype]; 
WITH (seb+type) SELECT FROM 
union ■> 
BEGIN 
IF -controlled 

THEN (seb+sei) . idvalue +■ BitAddress[wd:w, bd:b] 
ELSE 
BEGIN 

AssignField[tagsei]; 

(seb+sei) . idvalue <- (seb+tagsei) , idvalue; 
END; 
IF lastFillable AND b # AND '-ScanVariants[casectx. FindFit] 
THEN 

BEGIN FmWord[lastSei]; w ^ w+1; b <- END; 
maxLength <- vOrigin <- w*WordLength + b; 
[] ^ ScanVariants[casectx, AssignVariant]; 
padEnd *■ IF maxLength < WordLength 
THEN maxLength 

ELSE MAX[(vOrigin + WordFill )/WordLength, l]*WordLength; 
eqLengths ♦- TRUE; 

[] ♦" ScanVariants[casectx, PadVariant]; 
equalLengths <- eqLengths; 
(seb+sei) . idinfo ♦- 

(maxLength - vOrigin) + 

(IF controlled THEN (seb+tagsei ). idinfo ELSE 0); 
w <- maxLength/WordLength; b ♦- maxLength MOD WordLength; 
lastFillable <- FALSE; 
END; 
ENDCASE => AssignField[sei]; 
END; 
ENDLOOP; 
IF lastFillable AND b ^^ AND w > 

THEN BEGIN Fil lWord[l astSei ] ; b ♦- 0; w ♦- w + 1 END; 
(seb+rSei) .length <- w*WordLength + b; RETURN 
END; 

END. 



